home *** CD-ROM | disk | FTP | other *** search
Text File | 1989-01-07 | 15.4 KB | 760 lines | [TEXT/PJMM] |
- PROGRAM LSP_SHELL;
-
- {$I-}
-
- USES
- GLOBALS, INIT, SANE;
-
-
- PROCEDURE cfillptr (aP: Ptr; blockSize: Longint; fillChar: CHAR);
- EXTERNAL;
-
- PROCEDURE crfillptr (aP: Ptr; blockSize: Longint; fillChar: CHAR);
- EXTERNAL;
-
- PROCEDURE pfillptr (aP: Ptr; blockSize: Longint; fillChar: CHAR);
- VAR
- limitPtr: Ptr;
- BEGIN
- limitPtr := Ptr(ORD4(aP) + blockSize);
- WHILE ORD4(aP) < ORD4(limitPtr) DO
- BEGIN
- aP^ := SignedByte(fillChar);
- aP := Ptr(Succ(ORD4(aP)));
- END;
- END;
-
- PROCEDURE CalcPerformance;
- VAR
- divisor: Extended;
- BEGIN
- CASE perfIndex OF
- TO_C_FUNCTION:
- divisor := Extended(cTime / 1.0);
- TO_CR_FUNCTION:
- divisor := Extended(crTime / 1.0);
- TO_P_FUNCTION:
- divisor := Extended(pTime / 1.0);
- OTHERWISE
- ;
- END;
- IF divisor > 0.0 THEN
- BEGIN
- cPerf := cTime / divisor;
- crPerf := crTime / divisor;
- pPerf := pTime / divisor;
- END;
- END;
-
- PROCEDURE doRectFrame (r: Rect);
- BEGIN
- InsetRect(r, -1, -1);
- FrameRect(r);
- END;
-
- PROCEDURE DrawMainWindow;
- VAR
- aStr: Str255;
- hiliteRect: Rect;
- dForm: DecForm;
- dStr: DecStr;
- BEGIN
- doRectFrame(ptrSizeDst);
- doRectFrame(loopSizeDst);
- doRectFrame(cTimeDst);
- doRectFrame(crTimeDst);
- doRectFrame(pTimeDst);
- doRectFrame(cPerfDst);
- doRectFrame(crPerfDst);
- doRectFrame(pPerfDst);
-
- CASE perfIndex OF
- TO_C_FUNCTION:
- hiliteRect := cPerfDst;
- TO_CR_FUNCTION:
- hiliteRect := crPerfDst;
- TO_P_FUNCTION:
- hiliteRect := pPerfDst;
- OTHERWISE
- ;
- END;
-
- InsetRect(hiliteRect, -2, -2);
- FrameRect(hiliteRect);
-
- hiliteRect := theWindow^.portRect;
- WITH do_it^^.contrlRect DO
- BEGIN
- MoveTo(hiliteRect.left, bottom + 4);
- LineTo(hiliteRect.right, bottom + 4);
- MoveTo(hiliteRect.left, bottom + 6);
- LineTo(hiliteRect.right, bottom + 6);
- END;
-
- TextFace([bold]);
-
- aStr := 'Filling a block of';
- MoveTo(ptrSizeDst.left - 4 - StringWidth(aStr), ptrSizeDst.bottom - 4);
- DrawString(aStr);
-
- TextFace([]);
-
- NumToString(pSize, aStr);
- TextBox(Ptr(ORD(@aStr[1])), length(aStr), ptrSizeDst, teJustCenter);
-
- TextFace([bold]);
-
- aStr := 'bytes';
- MoveTo(ptrSizeDst.right + 4, ptrSizeDst.bottom - 4);
- DrawString(aStr);
-
- TextFace([]);
-
- NumToString(Longint(numLoops), aStr);
- TextBox(Ptr(ORD(@aStr[1])), length(aStr), loopSizeDst, teJustCenter);
-
- TextFace([bold]);
-
- aStr := 'times...';
- MoveTo(loopSizeDst.right + 4, loopSizeDst.bottom - 4);
- DrawString(aStr);
-
- aStr := 'C function';
- MoveTo(cTimeDst.left - 4 - StringWidth(aStr), cTimeDst.bottom - 4);
- DrawString(aStr);
-
- aStr := 'C function using registers';
- MoveTo(crTimeDst.left - 4 - StringWidth(aStr), crTimeDst.bottom - 4);
- DrawString(aStr);
-
- aStr := 'Pascal procedure';
- MoveTo(pTimeDst.left - 4 - StringWidth(aStr), pTimeDst.bottom - 4);
- DrawString(aStr);
-
- aStr := '1/60ths seconds';
-
- MoveTo(cTimeDst.left + (cTimeDst.right - cTimeDst.left - StringWidth(aStr)) DIV 2, cTimeDst.top - 8);
- DrawString(aStr);
-
- aStr := 'Performance Index';
-
- MoveTo(cPerfDst.left + (cPerfDst.right - cPerfDst.left - StringWidth(aStr)) DIV 2, cPerfDst.top - 8);
- DrawString(aStr);
-
- TextFace([]);
-
- NumToString(Longint(cTime), aStr);
- TextBox(Ptr(ORD(@aStr[1])), length(aStr), cTimeDst, teJustCenter);
-
- NumToString(Longint(crTime), aStr);
- TextBox(Ptr(ORD(@aStr[1])), length(aStr), crTimeDst, teJustCenter);
-
- NumToString(Longint(pTime), aStr);
- TextBox(Ptr(ORD(@aStr[1])), length(aStr), pTimeDst, teJustCenter);
-
- dForm.style := FIXEDDECIMAL;
- dForm.digits := 8;
-
- Num2Str(dForm, cPerf, dStr);
- TextBox(Ptr(ORD(@dStr[1])), length(dStr), cPerfDst, teJustCenter);
-
- Num2Str(dForm, crPerf, dStr);
- TextBox(Ptr(ORD(@dStr[1])), length(dStr), crPerfDst, teJustCenter);
-
- Num2Str(dForm, pPerf, dStr);
- TextBox(Ptr(ORD(@dStr[1])), length(dStr), pPerfDst, teJustCenter);
-
-
- END;
-
- PROCEDURE HandleUpdate (windToUpdate: WindowPtr);
- VAR
- currPort: GrafPtr;
- theRect: Rect;
- aStr: Str255;
- BEGIN
- GetPort(currPort);
- SetPort(windToUpdate);
-
- IF windToUpdate = theWindow THEN
- BEGIN
- BeginUpdate(windToUpdate);
- EraseRect(windToUpdate^.portRect);
- DrawControls(windToUpdate);
- DrawMainWindow;
- EndUpdate(windToUpdate);
- END
- ELSE
- BEGIN
- BeginUpdate(windToUpdate);
- EraseRect(windToUpdate^.portRect);
- EndUpdate(windToUpdate);
- END;
- SetPort(currPort);
- END;
-
- PROCEDURE DoTest;
- VAR
- index: Integer;
- timer: Longint;
- aPtr: Ptr;
- oldPort: GrafPtr;
- BEGIN
- SetCursor(GetCursor(watchCursor)^^);
-
- aPtr := NIL;
- aPtr := NewPtr(pSize);
- IF aPtr <> NIL THEN
- BEGIN
- GetPort(oldPort);
- SetPort(theWindow);
-
- FillRect(cTimeDst, gray);
- FillRect(cPerfDst, gray);
- cPerf := 0.0;
- timer := TickCount;
- WHILE timer = TickCount DO
- ;
- timer := TickCount;
- FOR index := 1 TO numLoops DO
- cfillptr(aPtr, pSize, 'A');
- cTime := TickCount - timer;
-
- InvalRect(cTimeDst);
- InvalRect(cPerfDst);
- HandleUpdate(theWindow);
-
- FillRect(crTimeDst, gray);
- FillRect(crPerfDst, gray);
- crPerf := 0.0;
- timer := TickCount;
- WHILE timer = TickCount DO
- ;
- timer := TickCount;
- FOR index := 1 TO numLoops DO
- crfillptr(aPtr, pSize, 'B');
- crTime := TickCount - timer;
-
- InvalRect(crPerfDst);
- InvalRect(crTimeDst);
- HandleUpdate(theWindow);
-
- FillRect(pTimeDst, gray);
- FillRect(pPerfDst, gray);
- pPerf := 0.0;
- timer := TickCount;
- WHILE timer = TickCount DO
- ;
- timer := TickCount;
- FOR index := 1 TO numLoops DO
- pfillptr(aPtr, pSize, 'C');
- pTime := TickCount - timer;
-
- InvalRect(pPerfDst);
- InvalRect(pTimeDst);
- HandleUpdate(theWindow);
-
- CalcPerformance;
-
- InvalRect(cPerfDst);
- InvalRect(crPerfDst);
- InvalRect(pPerfDst);
-
- DisposPtr(aPtr);
- SetPort(oldPort);
- END;
-
- InitCursor;
- END;
-
- PROCEDURE Easy_Out;
- BEGIN
- ExitToShell;
- END;
-
- PROCEDURE DoAbout;
- VAR
- AboutWindow: WindowPtr;
- AWRect: Rect;
- aStr: Str255;
- tHandle: Handle;
- goAway: ControlHandle;
- aControl: ControlHandle;
- lEvent: EventRecord;
- part: Integer;
- done: Boolean;
- BEGIN
- SetRect(AWRect, 0, 0, 400, 300);
- AboutWindow := NewWindow(NIL, AWRect, 'About Pascal • C Demo', FALSE, 4, WindowPtr(-1), FALSE, 0);
- SetPort(AboutWindow);
- TextFont(3);
- TextSize(9);
- TextFace([]);
- CenterWindow(AboutWindow, screenBits.bounds);
-
- AWRect := AboutWindow^.portRect;
- WITH AWRect DO
- BEGIN
- bottom := bottom - 20;
- top := bottom - 20;
- left := (right - left - 80) DIV 2;
- right := left + 80;
- END;
-
- goAway := NewControl(AboutWindow, AWRect, 'OK', TRUE, 0, 0, 1, 0, 0);
-
- ShowWindow(AboutWindow);
- DrawControls(AboutWindow);
-
- AWRect := AboutWindow^.portRect;
- AWRect.bottom := goAway^^.contrlRect.top - 10;
-
- InsetRect(AWRect, 8, 8);
- FrameRect(AWRect);
- InsetRect(AWRect, 2, 2);
- FrameRect(AWRect);
- InsetRect(AWRect, 10, 10);
-
- tHandle := GetResource('TEXT', 1000);
- HLock(tHandle);
- TextBox(tHandle^, GetHandleSize(tHandle), AWRect, teJustLeft);
- HUnlock(tHandle);
- ReleaseResource(tHandle);
-
- done := FALSE;
- REPEAT
- IF GetNextEvent(mDownMask + mUpMask, lEvent) THEN
- BEGIN
- GlobalToLocal(levent.where);
- part := FindControl(levent.where, AboutWindow, aControl);
- IF aControl = goAway THEN
- BEGIN
- part := TrackControl(aControl, levent.where, NIL);
- IF part = inButton THEN
- done := TRUE;
- END;
- END;
- UNTIL done;
-
- FlushEvents(mDownMask, 0);
-
- HideWindow(AboutWindow);
- DisposeWindow(AboutWindow);
-
- END;
-
- PROCEDURE DoAppleMenu (menuItem: Integer);
- VAR
- aStr: Str255;
- ignoreRef: Integer;
- BEGIN
- CASE menuItem OF
- ABOUTITEM:
- DoAbout;
- OTHERWISE
- BEGIN
- GetItem(appleMenu, menuItem, aStr);
- ignoreRef := OpenDeskAcc(aStr);
- END;
- END;
- END;
-
- PROCEDURE DoFileMenu (menuItem: Integer);
- BEGIN
- CASE menuItem OF
- NEWITEM:
- ;
- OPENITEM:
- ;
- CLOSEITEM:
- ;
- SAVEITEM:
- ;
- SAVEASITEM:
- ;
- PAGESETUPITEM:
- ;
- PRINTITEM:
- ;
- QUITITEM:
- userQuit := TRUE;
- OTHERWISE
- ;
- END;
- END;
-
- PROCEDURE DoEditMenu (menuItem: Integer);
- BEGIN
- IF NOT SystemEdit(menuItem - 1) THEN
- BEGIN
- CASE menuItem OF
- UNDOITEM:
- ;
- CUTITEM:
- ;
- COPYITEM:
- ;
- PASTEITEM:
- ;
- CLEARITEM:
- ;
- OTHERWISE
- ;
- END;
- END;
- END;
-
- PROCEDURE DoLoopMenu (menuItem: Integer);
- VAR
- iStr: Str255;
- newNum: Longint;
- index: Integer;
- limit: Integer;
- oldPort: GrafPtr;
- BEGIN
- GetItem(loopMenu, menuItem, iStr);
- StringToNum(iStr, newNum);
- numLoops := Integer(newNum);
-
- limit := CountMItems(loopMenu);
- FOR index := 1 TO limit DO
- CheckItem(loopMenu, index, FALSE);
- CheckItem(loopMenu, menuItem, TRUE);
-
- cTime := 0;
- crTime := 0;
- pTime := 0;
-
- GetPort(oldPort);
- SetPort(theWindow);
- InvalRect(loopSizeDst);
- InvalRect(cTimeDst);
- InvalRect(crTimeDst);
- InvalRect(pTimeDst);
- SetPort(oldPort);
-
- HandleUpdate(theWindow);
- END;
-
- PROCEDURE DoPointerMenu (menuItem: Integer);
- VAR
- iStr: Str255;
- spacePos: Integer;
- index: Integer;
- limit: Integer;
- oldPort: GrafPtr;
- BEGIN
- limit := CountMItems(pointerMenu);
- FOR index := 1 TO limit DO
- CheckItem(pointerMenu, index, FALSE);
- CheckItem(pointerMenu, menuItem, TRUE);
- GetItem(pointerMenu, menuItem, iStr);
- spacePos := Pos(' ', iStr);
- delete(iStr, spacePos, length(iStr) - spacePos + 1);
- StringToNum(iStr, pSize);
-
- cTime := 0;
- crTime := 0;
- pTime := 0;
-
- GetPort(oldPort);
- SetPort(theWindow);
- InvalRect(ptrSizeDst);
- SetPort(oldPort);
- HandleUpdate(theWindow);
- END;
-
- PROCEDURE DoCompareMenu (menuItem: Integer);
- BEGIN
- CASE menuItem OF
- 4:
- DoTest;
- OTHERWISE
- ;
- END;
- END;
-
- PROCEDURE DoMenuDispatch (menuCode: Longint);
- VAR
- menuID, menuItem: Integer;
- BEGIN
- menuID := HiWrd(menuCode);
- menuItem := LoWrd(menuCode);
- CASE menuID OF
- APPLEID:
- DoAppleMenu(menuItem);
- FILEID:
- DoFileMenu(menuItem);
- EDITID:
- DoEditMenu(menuItem);
- COMPAREID:
- DoCompareMenu(menuItem);
- POINTERID:
- DoPointerMenu(menuItem);
- LOOPID:
- DoLoopMenu(menuItem);
- OTHERWISE
- ;
- END;
- HiliteMenu(0);
- END;
-
- PROCEDURE FixEditMenu (forWhom: context);
- BEGIN
- CASE forWhom OF
- system:
- BEGIN
- EnableItem(editMenu, UNDOITEM);
- EnableItem(editMenu, CUTITEM);
- EnableItem(editMenu, COPYITEM);
- EnableItem(editMenu, PASTEITEM);
- EnableItem(editMenu, CLEARITEM);
- END;
- application:
- BEGIN
- DisableItem(editMenu, UNDOITEM);
- DisableItem(editMenu, CUTITEM);
- DisableItem(editMenu, COPYITEM);
- DisableItem(editMenu, PASTEITEM);
- DisableItem(editMenu, CLEARITEM);
- END;
- OTHERWISE
- ;
- END;
- END;
-
- PROCEDURE HandleMenus (clickPt: Point);
- VAR
- theMenuChoice: Longint;
- BEGIN
- theMenuChoice := MenuSelect(clickPt);
- DoMenuDispatch(theMenuChoice);
- END;
-
- PROCEDURE DoContent (inWindow: WindowPtr; mouseHit: Point);
- VAR
- part: Integer;
- theControl: ControlHandle;
- newPerformance: Integer;
- eRect: Rect;
- BEGIN
- IF inWindow <> FrontWindow THEN
- SelectWindow(inWindow)
- ELSE
- BEGIN
- GlobalToLocal(mouseHit);
-
- IF inWindow = theWindow THEN
- BEGIN
-
- part := FindControl(mouseHit, inWindow, theControl);
- IF (part = inButton) & (theControl = do_it) THEN
- BEGIN
- part := TrackControl(theControl, mouseHit, NIL);
- IF part = inButton THEN
- doTest;
- END
- ELSE
- BEGIN
- newPerformance := 0;
-
- IF PtInRect(mouseHit, cPerfDst) OR PtInRect(mouseHit, cTimeDst) THEN
- newPerformance := TO_C_FUNCTION;
- IF PtInRect(mouseHit, crPerfDst) OR PtInRect(mouseHit, crTimeDst) THEN
- newPerformance := TO_CR_FUNCTION;
- IF PtInRect(mouseHit, pPerfDst) OR PtInRect(mouseHit, pTimeDst) THEN
- newPerformance := TO_P_FUNCTION;
-
- IF newPerformance > 0 THEN
- BEGIN
- perfIndex := newPerformance;
- eRect := cPerfDst;
- InsetRect(eRect, -2, -2);
- InvalRect(eRect);
- eRect := crPerfDst;
- InsetRect(eRect, -2, -2);
- InvalRect(eRect);
- eRect := pPerfDst;
- InsetRect(eRect, -2, -2);
- InvalRect(eRect);
-
- CalcPerformance;
- END;
- END;
- END;
-
- END;
- END;
-
- PROCEDURE DoDrag (whichWindow: WindowPtr; startPt: Point);
- BEGIN
- SetPort(whichWindow);
- DragWindow(whichWindow, startPt, screenBits.bounds);
- END;
-
- PROCEDURE DoGrow (whichWindow: WindowPtr; startPt: Point);
- VAR
- limitRect: Rect;
- newSize: Longint;
- BEGIN
- IF whichWindow <> FrontWindow THEN
- SelectWindow(whichWindow)
- ELSE
- BEGIN
- SetRect(limitRect, 160, 80, 640, 480);
- newSize := GrowWindow(whichWindow, startPt, limitRect);
- IF newSize <> 0 THEN
- BEGIN
- InvalRect(whichWindow^.portRect);
- SizeWindow(whichWindow, LoWrd(newSize), HiWrd(newSize), TRUE);
- END;
- END;
- END;
-
- PROCEDURE DoGoAway (whichWindow: WindowPtr; whereHit: Point);
- BEGIN
- IF TrackGoAway(whichWindow, whereHit) THEN
- IF whichWindow = theWindow THEN
- userQuit := TRUE
- ELSE
- HideWindow(whichWindow);
- END;
-
- PROCEDURE DoZoom (zWindow: WindowPtr; whichWay: Integer);
- BEGIN
- HideWindow(zWindow);
- ZoomWindow(zWindow, whichWay, FALSE);
- ShowWindow(zWindow);
- END;
-
- PROCEDURE HandleMouseDown;
- VAR
- whichWindow: WindowPtr;
- thePart: Integer;
- BEGIN
- thePart := FindWindow(theEvent.where, whichWindow);
- CASE thePart OF
- inSysWindow:
- SystemClick(theEvent, whichWindow);
- inDesk:
- ;
- inMenuBar:
- HandleMenus(theEvent.where);
- inContent:
- DoContent(whichWindow, theEvent.where);
- inDrag:
- DoDrag(whichWindow, theEvent.where);
- inGrow:
- DoGrow(whichWindow, theEvent.where);
- inGoAway:
- DoGoAway(whichWindow, theEvent.where);
- inZoomIn, inZoomOut:
- DoZoom(whichWindow, thePart);
- OTHERWISE
- ;
- END;
- END;
-
- PROCEDURE HandleKeyDown;
- TYPE
- LongToKey = RECORD
- CASE boolean OF
- TRUE: (
- l: Longint
- );
- FALSE: (
- chs: PACKED ARRAY[1..4] OF CHAR
- );
- END;
- VAR
- ch: CHAR;
- BEGIN
- ch := LongToKey(theEvent.message).chs[4];
- IF BitAnd(theEvent.modifiers, cmdKey) = cmdKey THEN
- DoMenuDispatch(MenuKey(ch))
- ELSE
- BEGIN
- END;
- END;
-
- PROCEDURE HandleActivate;
- VAR
- currPort: GrafPtr;
- actWindow: WindowPtr;
- BEGIN
- GetPort(currPort);
- actWindow := WindowPtr(theEvent.message);
- SetPort(actWindow);
-
- IF actWindow = theWindow THEN
- BEGIN
- IF BitAnd(theEvent.modifiers, activeFlag) = activeFlag THEN
- BEGIN
- FixEditMenu(application);
- IF BitAnd(theEvent.modifiers, CHANGEFLAG) = CHANGEFLAG THEN
- BEGIN
- END;
- END
- ELSE
- BEGIN
- FixEditMenu(system);
- IF BitAnd(theEvent.modifiers, CHANGEFLAG) = CHANGEFLAG THEN
- BEGIN
- END;
- END;
- END;
-
- END;
-
- PROCEDURE CloseUpShop;
- BEGIN
- DeleteMenu(EDITID);
- DisposeMenu(editMenu);
- DeleteMenu(FILEID);
- DisposeMenu(fileMenu);
- DeleteMenu(APPLEID);
- DisposeMenu(appleMenu);
- DeleteMenu(LOOPID);
- DisposeMenu(loopMenu);
- DeleteMenu(COMPAREID);
- DisposeMenu(compareMenu);
-
- DrawMenuBar;
-
- WHILE FrontWindow <> NIL DO
- HideWindow(FrontWindow);
- END;
-
- PROCEDURE HandleTheEvent;
- BEGIN
- CASE theEvent.what OF
- mouseDown:
- HandleMouseDown;
- keyDown, autoKey:
- HandleKeyDown;
- updateEvt:
- HandleUpdate(WindowPtr(theEvent.message));
- activateEvt:
- HandleActivate;
- OTHERWISE
- ;
- END;
- END;
-
- BEGIN
- Init_Mac(@Easy_Out);
- MakeMenus;
- MakeWindow;
- UnloadSeg(@Init_Mac);
-
- userQuit := FALSE;
-
- REPEAT
- SystemTask;
- IF GetNextEvent(everyEvent, theEvent) THEN
- HandleTheEvent;
- UNTIL userQuit;
-
- CloseUpShop;
-
- END.